home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / bbs_util / dctta005.zip / TAGSRC05.ZIP / COMPILE.PAS next >
Pascal/Delphi Source File  |  1996-06-11  |  5KB  |  176 lines
  1. {  DCTTag v0.05 Compilation Utility -  Compile.Pas  -  June 11, 1996.  }
  2. {  Copyright 1995, 1996 by Dan Traczynski.  All rights reserved.       }
  3.  
  4. Uses Crt;
  5.  
  6. Type Str72    = String[72];
  7.  
  8. Var CurClr,
  9.     X, Y      : Byte;
  10.     Filename,
  11.     Tmp       : String;
  12.     Ch        : Char;
  13.     Decomp    : Boolean;
  14.     TmpStr    : Str72;
  15.  
  16. Procedure DispHelp;
  17. Begin
  18.  WriteLn('COMPILE [Drive:][Path]<File Name> [/?] [/D]');
  19.  WriteLn;
  20.  WriteLn('  [Drive][Path]<File Name>   Specifies tagline text file to compile.');
  21.  WriteLn('  /?      Displays help screen.');
  22.  WriteLn('  /D      Decompile DCTTAG.TAG to <File Name>.');
  23.  WriteLn;
  24.  WriteLn('The tagline file must be a plain ASCII text file, and each line can');
  25.  WriteLn('be no longer than 72 characters.');
  26.  Halt(0);
  27. End;
  28.  
  29. Procedure InvalidSwitch;
  30. Begin
  31.   Write('Invalid Switch - ');
  32.   TextColor(15);
  33.   WriteLn(Tmp);
  34.   TextColor(CurClr);
  35.   Halt(0);
  36. End;
  37.  
  38. Procedure InvalidFileName;
  39. Begin
  40.   Write('Invalid File Name - ');
  41.   TextColor(15);
  42.   WriteLn(Tmp);
  43.   TextColor(CurClr);
  44.   Halt(0);
  45. End;
  46.  
  47. Procedure Compile;
  48. Var InpFile : Text;
  49.     OutFile : File Of Str72;
  50. Begin
  51.  Assign(InpFile, Filename);
  52.  {$I-} Reset(InpFile); {$I+}
  53.  If IOResult <> 0 Then Begin
  54.    Write('File '); TextColor(15); Write(Filename); TextColor(7);
  55.    WriteLn(' does not exist.'); TextColor(CurClr); Halt(0);
  56.    Close(InpFile);
  57.  End;
  58.  Assign(OutFile, 'DCTTAG.TAG');
  59.  {$I-} Reset(OutFile); {$I+}
  60.  If IOResult = 0 Then Begin
  61.    Write('DCTTAG.TAG already exists.  Overwrite (');
  62.    TextColor(15); Write('Y'); TextColor(7); Write('es/');
  63.    TextColor(15); Write('N'); TextColor(7); Write('o/');
  64.    TextColor(15); Write('A'); TextColor(7); Write('ppend)? ');
  65.    Repeat
  66.      Ch := UpCase(ReadKey);
  67.    Until Ch In ['Y', 'N', 'A'];
  68.    WriteLn(Ch);
  69.    WriteLn;
  70.    Case Ch Of
  71.      'N': Begin
  72.             Close(InpFile);
  73.             Close(OutFile);
  74.             WriteLn('Tagline file not compiled.');
  75.             Halt(1);
  76.           End;
  77.      'A': Begin
  78.             Reset(OutFile);
  79.             Seek(Outfile, FileSize(Outfile));
  80.             WriteLn('Appending ', FileName, ' to DCTTAG.TAG...');
  81.           End;
  82.      Else Begin
  83.             ReWrite(OutFile);
  84.             WriteLn('Compiling ', FileName, ' to DCTTAG.TAG...');
  85.           End;
  86.    End;
  87.  End Else Begin
  88.    ReWrite(OutFile);
  89.    WriteLn('Compiling ', Filename, ' to DCTTAG.TAG...');
  90.  End;
  91.  While Not Eof(InpFile) Do Begin
  92.    ReadLn(InpFile, TmpStr);
  93.    If TmpStr <> '' Then Write(OutFile, TmpStr);
  94.  End;
  95.  WriteLn('All done!');
  96.  WriteLn;
  97.  WriteLn(FileSize(OutFile), ' taglines compiled.');
  98.  Close(InpFile);
  99.  Close(OutFile);
  100. End;
  101.  
  102. Procedure Decompile;
  103. Var InpFile   : File Of Str72;
  104.     OutFile   : Text;
  105. Begin
  106.  Assign(InpFile, 'DCTTAG.TAG');
  107.  {$I-} Reset(InpFile); {$I+}
  108.  If IOResult <> 0 Then Begin
  109.    Write('File '); TextColor(15); Write('DCTTAG.TAG'); TextColor(7);
  110.    WriteLn(' does not exist.'); TextColor(CurClr); Halt(0);
  111.    Close(InpFile);
  112.  End;
  113.  Assign(OutFile, Filename);
  114.  {$I-} Reset(OutFile); {$I+}
  115.  If IOResult = 0 Then Begin
  116.    Write(Filename, ' already exists.  Overwrite (Y/N)? ');
  117.    Repeat
  118.      Ch := UpCase(ReadKey);
  119.    Until Ch In ['Y', 'N'];
  120.    WriteLn(Ch);
  121.    WriteLn;
  122.    If Ch = 'N' Then Begin
  123.      Close(InpFile);
  124.      Close(OutFile);
  125.      WriteLn('Tagline file not decompiled.');
  126.      Halt(1);
  127.    End;
  128.  End;
  129.  ReWrite(OutFile);
  130.  WriteLn('Decompiling DCTTAG.TAG to ', Filename, '...');
  131.  While Not Eof(InpFile) Do Begin
  132.    Read(InpFile, TmpStr);
  133.    WriteLn(OutFile, TmpStr);
  134.  End;
  135.  WriteLn('All done!');
  136.  WriteLn;
  137.  WriteLn(FileSize(InpFile), ' taglines decompiled.');
  138.  Close(InpFile);
  139.  Close(OutFile);
  140. End;
  141.  
  142. Begin
  143.  CurClr := TextAttr;
  144.  Decomp := False;
  145.  Filename := '';
  146.  TextColor(7);
  147.  TextBackground(0);
  148.  WriteLn('DCTTag v0.05 Tagline Compilation Utility.');
  149.  WriteLn;
  150.  If (ParamCount = 0) Then
  151.    DispHelp
  152.  Else
  153.    For X := 1 To ParamCount Do Begin
  154.      Tmp := ParamStr(X);
  155.      For Y := 1 To Length(Tmp) Do Tmp[Y] := UpCase(Tmp[Y]);
  156.      If (Tmp = '/?') Then
  157.        DispHelp
  158.      Else If (Tmp = '/D') Then
  159.        Decomp := True
  160.      Else If (Tmp[1] = '/') Then Begin
  161.        InvalidSwitch;
  162.      End Else If Filename = '' Then Begin
  163.        If (Pos('?', Tmp) > 0) Or (Pos('*', Tmp) > 0) Then InvalidFilename;
  164.        Filename := Tmp;
  165.      End;
  166.    End; {for x=1 to paramcount}
  167.  If Filename = '' Then Begin
  168.   WriteLn('No file specified.');
  169.   Halt(0);
  170.  End;
  171.  If Filename = 'DCTTAG.TAG' Then Begin
  172.   WriteLn('Source and destination files cannot be the same.');
  173.   Halt(0);
  174.  End;
  175.  If Decomp Then Decompile Else Compile;
  176. End.